YES 4.003 H-Termination proof of /home/matraf/haskell/eval_FullyBlown_Fast/empty.hs
H-Termination of the given Haskell-Program with start terms could successfully be proven:



HASKELL
  ↳ LR

mainModule Main
  ((lexDigits :: [Char ->  [([Char],[Char])]) :: [Char ->  [([Char],[Char])])

module Main where
  import qualified Prelude



Lambda Reductions:
The following Lambda expression
\vu68
case vu68 of
 (cs@(_ : _),t) → (cs,t: []
 _ → []

is transformed to
nonnull0 vu68 = 
case vu68 of
 (cs@(_ : _),t) → (cs,t: []
 _ → []

The following Lambda expression
\(_,zs)→zs

is transformed to
zs0 (_,zs) = zs

The following Lambda expression
\(ys,_)→ys

is transformed to
ys0 (ys,_) = ys



↳ HASKELL
  ↳ LR
HASKELL
      ↳ CR

mainModule Main
  ((lexDigits :: [Char ->  [([Char],[Char])]) :: [Char ->  [([Char],[Char])])

module Main where
  import qualified Prelude



Case Reductions:
The following Case expression
case vu68 of
 (cs@(_ : _),t) → (cs,t: []
 _ → []

is transformed to
nonnull00 (cs@(_ : _),t) = (cs,t: []
nonnull00 _ = []



↳ HASKELL
  ↳ LR
    ↳ HASKELL
      ↳ CR
HASKELL
          ↳ BR

mainModule Main
  ((lexDigits :: [Char ->  [([Char],[Char])]) :: [Char ->  [([Char],[Char])])

module Main where
  import qualified Prelude



Replaced joker patterns by fresh variables and removed binding patterns.
Binding Reductions:
The bind variable of the following binding Pattern
cs@(vy : vz)

is replaced by the following term
vy : vz

The bind variable of the following binding Pattern
xs@(wv : ww)

is replaced by the following term
wv : ww



↳ HASKELL
  ↳ LR
    ↳ HASKELL
      ↳ CR
        ↳ HASKELL
          ↳ BR
HASKELL
              ↳ COR

mainModule Main
  ((lexDigits :: [Char ->  [([Char],[Char])]) :: [Char ->  [([Char],[Char])])

module Main where
  import qualified Prelude



Cond Reductions:
The following Function with conditions
undefined 
 | False
 = undefined

is transformed to
undefined  = undefined1

undefined0 True = undefined

undefined1  = undefined0 False

The following Function with conditions
span p [] = ([],[])
span p (wv : ww)
 | p wv
 = (wv : ys,zs)
 | otherwise
 = ([],wv : ww)
where 
vu43  = span p ww
ys  = ys0 vu43
ys0 (ys,wx) = ys
zs  = zs0 vu43
zs0 (wy,zs) = zs

is transformed to
span p [] = span3 p []
span p (wv : ww) = span2 p (wv : ww)

span2 p (wv : ww) = 
span1 p wv ww (p wv)
where 
span0 p wv ww True = ([],wv : ww)
span1 p wv ww True = (wv : ys,zs)
span1 p wv ww False = span0 p wv ww otherwise
vu43  = span p ww
ys  = ys0 vu43
ys0 (ys,wx) = ys
zs  = zs0 vu43
zs0 (wy,zs) = zs

span3 p [] = ([],[])
span3 xw xx = span2 xw xx



↳ HASKELL
  ↳ LR
    ↳ HASKELL
      ↳ CR
        ↳ HASKELL
          ↳ BR
            ↳ HASKELL
              ↳ COR
HASKELL
                  ↳ LetRed

mainModule Main
  ((lexDigits :: [Char ->  [([Char],[Char])]) :: [Char ->  [([Char],[Char])])

module Main where
  import qualified Prelude



Let/Where Reductions:
The bindings of the following Let/Where expression
span1 p wv ww (p wv)
where 
span0 p wv ww True = ([],wv : ww)
span1 p wv ww True = (wv : ys,zs)
span1 p wv ww False = span0 p wv ww otherwise
vu43  = span p ww
ys  = ys0 vu43
ys0 (ys,wx) = ys
zs  = zs0 vu43
zs0 (wy,zs) = zs

are unpacked to the following functions on top level
span2Ys0 xy xz (ys,wx) = ys

span2Zs0 xy xz (wy,zs) = zs

span2Ys xy xz = span2Ys0 xy xz (span2Vu43 xy xz)

span2Vu43 xy xz = span xy xz

span2Span1 xy xz p wv ww True = (wv : span2Ys xy xz,span2Zs xy xz)
span2Span1 xy xz p wv ww False = span2Span0 xy xz p wv ww otherwise

span2Zs xy xz = span2Zs0 xy xz (span2Vu43 xy xz)

span2Span0 xy xz p wv ww True = ([],wv : ww)



↳ HASKELL
  ↳ LR
    ↳ HASKELL
      ↳ CR
        ↳ HASKELL
          ↳ BR
            ↳ HASKELL
              ↳ COR
                ↳ HASKELL
                  ↳ LetRed
HASKELL
                      ↳ NumRed

mainModule Main
  ((lexDigits :: [Char ->  [([Char],[Char])]) :: [Char ->  [([Char],[Char])])

module Main where
  import qualified Prelude



Num Reduction: All numbers are transformed to thier corresponding representation with Pos, Neg, Succ and Zero.

↳ HASKELL
  ↳ LR
    ↳ HASKELL
      ↳ CR
        ↳ HASKELL
          ↳ BR
            ↳ HASKELL
              ↳ COR
                ↳ HASKELL
                  ↳ LetRed
                    ↳ HASKELL
                      ↳ NumRed
HASKELL
                          ↳ Narrow

mainModule Main
  (lexDigits :: [Char ->  [([Char],[Char])])

module Main where
  import qualified Prelude



Haskell To QDPs


↳ HASKELL
  ↳ LR
    ↳ HASKELL
      ↳ CR
        ↳ HASKELL
          ↳ BR
            ↳ HASKELL
              ↳ COR
                ↳ HASKELL
                  ↳ LetRed
                    ↳ HASKELL
                      ↳ NumRed
                        ↳ HASKELL
                          ↳ Narrow
                            ↳ AND
QDP
                                ↳ QDPSizeChangeProof
                              ↳ QDP
                              ↳ QDP

Q DP problem:
The TRS P consists of the following rules:

new_span2Zs00(yu98, yu99, Succ(yu1000), Zero, yu102) → new_span2Zs01(yu98, yu99, Succ(yu98), Succ(yu102))
new_span2Ys00(yu86, yu87, Succ(yu880), Zero, yu90) → new_span2Ys01(yu86, yu87, Succ(yu86), Succ(yu90))
new_span2Zs01(yu141, yu142, Zero, Zero) → new_span2Zs03(yu141, yu142)
new_span2Ys03(yu136, yu137) → new_span2Zs(yu137)
new_span2Zs01(yu141, yu142, Succ(yu1430), Succ(yu1440)) → new_span2Zs01(yu141, yu142, yu1430, yu1440)
new_span2Ys01(yu136, yu137, Zero, Succ(yu1390)) → new_span2Zs(yu137)
new_span2Zs01(yu141, yu142, Zero, Succ(yu1440)) → new_span2Zs(yu142)
new_span2Zs01(yu141, yu142, Zero, Succ(yu1440)) → new_span2Ys(yu142)
new_span2Zs03(yu141, yu142) → new_span2Ys(yu142)
new_span2Ys01(yu136, yu137, Succ(yu1380), Succ(yu1390)) → new_span2Ys01(yu136, yu137, yu1380, yu1390)
new_span2Ys01(yu136, yu137, Zero, Zero) → new_span2Ys03(yu136, yu137)
new_span2Zs0(Char(Succ(yu8100)), yu82, yu83, yu84) → new_span2Zs00(yu8100, yu82, yu8100, yu83, yu84)
new_span2Ys(:(yu620, yu621)) → new_span2Ys0(yu620, yu621, Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Zero))))))))))))))))))))))))))))))))))))))))))))))), Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Zero)))))))))))))))))))))))))))))))))))))))))))))))))))))))))
new_span2Ys00(yu86, yu87, Succ(yu880), Succ(yu890), yu90) → new_span2Ys00(yu86, yu87, yu880, yu890, yu90)
new_span2Zs(:(yu620, yu621)) → new_span2Zs0(yu620, yu621, Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Zero))))))))))))))))))))))))))))))))))))))))))))))), Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Succ(Zero)))))))))))))))))))))))))))))))))))))))))))))))))))))))))
new_span2Ys03(yu136, yu137) → new_span2Ys(yu137)
new_span2Zs02(yu98, yu99, yu102) → new_span2Zs01(yu98, yu99, Succ(yu98), Succ(yu102))
new_span2Zs00(yu98, yu99, Zero, Zero, yu102) → new_span2Zs02(yu98, yu99, yu102)
new_span2Ys00(yu86, yu87, Zero, Zero, yu90) → new_span2Ys02(yu86, yu87, yu90)
new_span2Ys01(yu136, yu137, Zero, Succ(yu1390)) → new_span2Ys(yu137)
new_span2Zs00(yu98, yu99, Succ(yu1000), Succ(yu1010), yu102) → new_span2Zs00(yu98, yu99, yu1000, yu1010, yu102)
new_span2Zs03(yu141, yu142) → new_span2Zs(yu142)
new_span2Ys02(yu86, yu87, yu90) → new_span2Ys01(yu86, yu87, Succ(yu86), Succ(yu90))
new_span2Ys0(Char(Succ(yu7600)), yu77, yu78, yu79) → new_span2Ys00(yu7600, yu77, yu7600, yu78, yu79)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
By using the subterm criterion [20] together with the size-change analysis [32] we have proven that there are no infinite chains for this DP problem.

From the DPs we obtained the following set of size-change graphs:



↳ HASKELL
  ↳ LR
    ↳ HASKELL
      ↳ CR
        ↳ HASKELL
          ↳ BR
            ↳ HASKELL
              ↳ COR
                ↳ HASKELL
                  ↳ LetRed
                    ↳ HASKELL
                      ↳ NumRed
                        ↳ HASKELL
                          ↳ Narrow
                            ↳ AND
                              ↳ QDP
QDP
                                ↳ QDPSizeChangeProof
                              ↳ QDP

Q DP problem:
The TRS P consists of the following rules:

new_psPs(yu62, yu63, Succ(yu640), Succ(yu650), yu66) → new_psPs(yu62, yu63, yu640, yu650, yu66)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
By using the subterm criterion [20] together with the size-change analysis [32] we have proven that there are no infinite chains for this DP problem.

From the DPs we obtained the following set of size-change graphs:



↳ HASKELL
  ↳ LR
    ↳ HASKELL
      ↳ CR
        ↳ HASKELL
          ↳ BR
            ↳ HASKELL
              ↳ COR
                ↳ HASKELL
                  ↳ LetRed
                    ↳ HASKELL
                      ↳ NumRed
                        ↳ HASKELL
                          ↳ Narrow
                            ↳ AND
                              ↳ QDP
                              ↳ QDP
QDP
                                ↳ QDPSizeChangeProof

Q DP problem:
The TRS P consists of the following rules:

new_psPs0(yu27, yu28, Succ(yu290), Succ(yu300), yu31, yu32) → new_psPs0(yu27, yu28, yu290, yu300, yu31, yu32)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
By using the subterm criterion [20] together with the size-change analysis [32] we have proven that there are no infinite chains for this DP problem.

From the DPs we obtained the following set of size-change graphs: